home *** CD-ROM | disk | FTP | other *** search
- {$i VGADECL.INC}
-
- const
-
- coltxt:array[1..max_mode] of string[4]=('TXT','TXT2','TXT4','HRC','CGA1'
- ,'CGA2','PL1','PL1E','PL2','PK2','PL4','PK4','PK4a','PK4b','P8','P15','P16'
- ,'P24','P24b','P32','P32b','P32c','P32d');
-
-
-
-
- const
- colbits:array[1..max_mode] of integer= {Bits of data per pixel}
- (0,0,0,1,1,1,1,2,2,2,4,4,4,4,8,15,16,24,24,24,24,24,24);
- usebits:array[1..max_mode] of integer= {Bits used per pixel}
- (0,0,0,1,1,1,1,2,2,2,4,4,4,4,8,16,16,24,24,32,32,32,32);
- modecols:array[1..max_mode] of longint=
- (0,0,0,2,2,2,2,4,4,4,16,16,16,16,256,32768,65536
- ,16777216,16777216,16777216,16777216,16777216,16777216);
-
-
-
- type
- modetype=record
- md,xres,yres,bytes:word;
- memmode:byte;
- end;
-
- regblk=record
- base:word;
- nbr:word;
- x:array[0..255] of byte;
- end;
-
- regtype=record
- chip:byte;
- mmode:byte;
- mode,pixels,lins,bytes,tridold0d,tridold0e:word;
- attregs:array[0..31] of byte;
- seqregs,grcregs,crtcregs,xxregs:regblk;
- stdregs:array[$3c0..$3df] of byte;
- xgaregs:array[0..15] of byte;
- dacregs:array[0..16] of byte;
- dacinxd:regblk;
- end;
-
-
-
- var
- f:file of regtype;
- fo:text;
- s:string;
-
- xxs,ix,off:word;
- mxcrtc,mxseq,mxattr,mxgrf,mxxtra,xtraix:word;
- xx:array[1..40] of regtype;
-
- const hx:array[0..15] of char='0123456789ABCDEF';
-
- function hex2(w:word):string;
- begin
- hex2:=hx[(w shr 4) and 15]+hx[w and 15];
- end;
-
- function hex4(w:word):string;
- begin
- hex4:=hx[w shr 12]+hx[hi(w) and 15]+hx[(w shr 4) and 15]+hx[w and 15];
- end;
-
- function gtbyte(var s:string):word;
- var i,j:word;
- begin
- while copy(s,1,1)=' ' do delete(s,1,1);
- i:=(ord(s[1])-48) and 31;if i>9 then dec(i,7);
- j:=(ord(s[2])-48) and 31;if j>9 then dec(j,7);
- delete(s,1,2);
- gtbyte:=i*16+j;
- end;
-
- function gtword(var s:string):word;
- var i,j:word;
- begin
- i:=gtbyte(s);
- j:=gtbyte(s);
- gtword:=i*256+j;
- end;
-
- function gtval(var s:string):longint;
- var x,z:word;
- y:longint;
- begin
- x:=pos(': ',s);
- delete(s,1,x+1);
- x:=pos(' ',s);if x=0 then x:=length(s)+1;
- val(copy(s,1,x-1),y,z);
- delete(s,1,x);
- gtval:=y;
- end;
-
-
- var
- parms:word;
- parm:array[1..256] of word;
- parmsame:boolean;
- parmstr:string;
-
- procedure setstr(s:string);
- begin
- parms:=0;
- parmstr:=s;
- parmsame:=true;
- end;
-
- procedure adds(w:word);
- begin
- inc(parms);
- parm[parms]:=w;
- if parm[1]<>w then parmsame:=false;
- end;
-
- function getstr:string;
- var x:word;
- begin
- if parmsame then parms:=1;
- for x:=1 to parms do
- parmstr:=parmstr+' '+hex4(parm[x]);
- getstr:=parmstr;
- end;
-
-
- var x,y:word;
- l:longint;
-
- dacix,mxdaci:word;
- begin
- assign(f,'register.vga');
- reset(f);
- xxs:=0;ix:=0;off:=0;xtraix:=0;dacix:=0;mxdaci:=0;
- mxcrtc:=0;mxattr:=31;mxseq:=0;mxgrf:=0;mxxtra:=0;
- fillchar(xx,sizeof(xx),0);
- while not eof(f) do
- begin
- inc(xxs);
- read(f,xx[xxs]);
- if xx[xxs].seqregs.nbr>mxseq then mxseq:=xx[xxs].seqregs.nbr;
- if xx[xxs].grcregs.nbr>mxgrf then mxgrf:=xx[xxs].grcregs.nbr;
- if xx[xxs].crtcregs.nbr>mxcrtc then mxcrtc:=xx[xxs].crtcregs.nbr;
- if xx[xxs].xxregs.base<>0 then
- begin
- xtraix:=xx[xxs].xxregs.base;
- if xx[xxs].xxregs.nbr>mxxtra then mxxtra:=xx[xxs].xxregs.nbr;
- end;
- if xx[xxs].dacinxd.base<>0 then
- begin
- dacix:=xx[xxs].dacinxd.base;
- if xx[xxs].dacinxd.nbr>mxdaci then mxdaci:=xx[xxs].dacinxd.nbr;
- end;
- end;
- close(f);
-
- assign(fo,'register.tbl');
- rewrite(fo);
- write(fo,'Mode: ');
- for y:=1 to xxs do write(fo,hex4(xx[y].mode):5);
- writeln(fo);
- write(fo,'Pixels: ');
- for y:=1 to xxs do write(fo,xx[y].pixels:5);
- writeln(fo);
- write(fo,'Lines: ');
- for y:=1 to xxs do write(fo,xx[y].lins:5);
- writeln(fo);
- write(fo,'Bytes: ');
- for y:=1 to xxs do write(fo,xx[y].bytes:5);
- writeln(fo);
- write(fo,'Colors: ');
- for y:=1 to xxs do write(fo,coltxt[xx[y].mmode]:5);
- writeln(fo);
- setstr('3CCh :');
- for y:=1 to xxs do adds(xx[y].stdregs[$3CC]);
- writeln(fo,getstr);
-
- if xx[1].chip=__Trid then
- begin
- setstr('SEQ_0D :');
- for y:=1 to xxs do adds(xx[y].tridold0D);
- writeln(fo,getstr);
- setstr('SEQ_0E :');
- for y:=1 to xxs do adds(xx[y].tridold0E);
- writeln(fo,getstr);
- end;
-
- for x:=0 to mxattr do
- begin
- setstr('ATTR '+hex2(x)+':');
- for y:=1 to xxs do adds(xx[y].attregs[x]);
- writeln(fo,getstr);
- end;
- for x:=0 to mxSEQ do
- begin
- setstr('SEQ '+hex2(x)+': ');
- for y:=1 to xxs do adds(xx[y].seqregs.x[x]);
- writeln(fo,getstr);
- end;
- for x:=0 to mxgrf do
- begin
- setstr('GRF '+hex2(x)+': ');
- for y:=1 to xxs do adds(xx[y].grcregs.x[x]);
- writeln(fo,getstr);
- end;
- for x:=0 to mxcrtc do
- begin
- setstr('CRTC '+hex2(x)+':');
- for y:=1 to xxs do adds(xx[y].crtcregs.x[x]);
- writeln(fo,getstr);
- end;
- if xtraix<>0 then
- for x:=0 to mxxtra do
- begin
- setstr(hex4(xtraix)+' '+hex2(x)+':');
- for y:=1 to xxs do adds(xx[y].xxregs.x[x]);
- writeln(fo,getstr);
- end;
- for x:=0 to 16 do
- begin
- setstr('DAC '+hex2(x)+':');
- for y:=1 to xxs do adds(xx[y].dacregs[x]);
- writeln(fo,getstr);
- end;
- if dacix<>0 then
- for x:=0 to mxdaci do
- begin
- setstr('DACi '+hex2(x)+':');
- for y:=1 to xxs do adds(xx[y].dacinxd.x[x]);
- writeln(fo,getstr);
- end;
- close(fo);
- end.
-
-